home *** CD-ROM | disk | FTP | other *** search
- ' -- XYMODEM.BAS --
- '
- ' This program is donated to the Public
- ' Domain by MarshallSoft Computing, Inc.
- ' It is provided as an example of the use
- ' of the Personal Communications Library.
- '
-
- DefInt A-Z
-
- '$INCLUDE: 'XYPACKET.BI'
- '$INCLUDE: 'TERM_IO.BI'
- '$INCLUDE: 'MODEM_IO.BI'
- '$INCLUDE: 'PCL4B.BI'
- '$INCLUDE: 'XYMODEM.BI'
-
- Const NAK = &H15, CAN = &H18
- CONST FALSE = 0, TRUE = NOT FALSE
-
-
- Function FetchName (Filename$)
- FetchName = True
- If Len(Filename$) = 0 Then
- Call WriteMsg("Enter filename: ", 1)
- Call ReadMsg(Filename$, 16, 20)
- If Len(Filename) = 0 Then
- FetchName = False
- End If
- End If
- End Function
-
- Function RxyModem (ByVal Port, Filename$, ByVal NCGbyte, ByVal BatchFlag)
- On Local Error GoTo RxyTrap
- ErrorFlag = False
- EOTflag = False
- Call WriteMsg("XYMODEM Receive: Waiting for Sender ", 1)
- 'clear comm port
- Code = SioRxFlush(Port)
- 'Send NAKs or 'C's
- If Not RxStartup(Port, NCGbyte) Then
- RxyModem = False
- Exit Function
- End If
- 'open file unless BatchFlag is on
- If BatchFlag Then
- FirstPacket = 0
- Else
- FirstPacket = 1
- 'Open file for write
- FileNbr = FreeFile
- Open Filename$ For Binary Access Write As FileNbr
- Print "Opening "; Filename$
- End If
- 'get each packet in turn
- For Packet = FirstPacket To 32767
- 'user aborts ?
- AnyKey$ = INKEY$
- If AnyKey$ = Str$(CAN) Then
- TxCAN (Port)
- Call WriteMsg("*** Canceled by USER ***", 1)
- RxyModem = False
- Exit Function
- End If
- 'issue message
- Message$ = "Packet " + Str$(Packet)
- Call WriteMsg(Message$, 1)
- PacketNbr = Packet And 255
- 'get next packet (RxPacket will allocate Buffer$)
- Buffer$ = ""
- If Not RxPacket(Port, Packet, Buffer$, BufferSize, NCGbyte, EOTflag) Then
- RxyModem = False
- Exit Function
- End If
- 'packet 0 ?
- If Packet = 0 Then
- If Left$(Buffer$, 1) = Chr$(0) Then
- Call WriteMsg("Batch transfer complete", 1)
- RxyModem = True
- Exit Function
- End If
- 'construct filename
- I = 1
- Filename$ = ""
- Byte$ = String$(1, 0)
- Do
- Byte$ = Mid$(Buffer$, I, 1)
- If Byte$ = Chr$(0) Then
- Exit Do
- End If
- Filename$ = Filename$ + Byte$
- I = I + 1
- Loop
- 'get file size
- I = I + 1
- Temp$ = ""
- Do
- Byte$ = Mid$(Buffer$, I, 1)
- If Byte$ = Chr$(0) Then
- Exit Do
- End If
- Temp$ = Temp$ + Byte$
- I = I + 1
- Loop
- FileBytes& = Val(Temp$)
- End If
- 'all done if EOT was received
- If EOTflag Then
- Close FileNbr
- Call WriteMsg("Transfer completed", 1)
- RxyModem = True
- Exit Function
- End If
- 'process the packet
- If Packet = 0 Then
- 'open file using filename in packet 0
- FileNbr = FreeFile
- Open Filename$ For Binary Access Write As FileNbr
- Print "Opening "; Filename$
- 'must restart after packet 0
- Flag = RxStartup(Port, NCGbyte)
- Else
- 'Packet > 0 ==> write Buffer$
- Put FileNbr, , Buffer$
- End If
- Next Packet
- Close FileNbr
- Exit Function
- RxyTrap:
- Select Case Err
- Case 52
- Message$ = "Cannot open " + Filename$ + " for write"
- Call WriteMsg(Message$, 1)
- Case Else
- Print "RX Error: "; Error$; " ("; Err; ")"
- End Select
- RxyModem = False
- Exit Function
- End Function
-
- Function TxyModem (ByVal Port, Filename$, ByVal OneKflag, ByVal BatchFlag)
- '''PRINT "TxyModem: Filename$=";Filename$;" ,LEN=";LEN(Filename$)
- On Local Error GoTo TxyTrap
- Number128& = 0
- Number1K& = 0
- NCGbyte = NAK
- EOTflag = False
- EmptyFlag = False
- If BatchFlag Then
- If Len(Filename$) = 0 Then
- EmptyFlag = True
- End If
- End If
- If Not EmptyFlag Then
- FileNbr = FreeFile
- Open Filename$ For Binary Access Read As FileNbr
- Print "Opening "; Filename$
- End If
- Call WriteMsg("XYMODEM: waiting for receiver ", 1)
- 'compute # blocks
- If EmptyFlag Then
- 'empty file
- Number128& = 0
- Number1K& = 0
- Else
- 'filename is not empty. compute file length
- FileBytes& = LOF(FileNbr)
- RemainingBytes& = FileBytes&
- If OneKflag Then
- Number1K& = FileBytes& \ 1024
- Else
- Number1K& = 0
- End If
- Number128& = (FileBytes& - 1024 * Number1K&) \ 128
- If (128 * Number128& + 1024 * Number1K&) < FileBytes& Then
- Number128& = Number128& + 1
- End If
- Message$ = Str$(Number1K&) + " 1K & " + Str$(Number128&) + " 128-byte packets"
- Call WriteMsg(Message$, 1)
- Print Message$
- End If
- 'clear comm port (there may be several NAKs queued up)
- Code = SioRxFlush(Port)
- 'get receivers start up NAK or 'C'
- If Not TxStartup(Port, NCGbyte) Then
- TxyModem = False
- Exit Function
- End If
- 'loop over all packets
- If BatchFlag Then
- FirstPacket = 0
- Else
- FirstPacket = 1
- End If
- 'transmit each packet in turn
- For Packet = FirstPacket To Number1K& + Number128&
- 'user aborts ?
- AnyKey$ = INKEY$
- If AnyKey$ = Str$(CAN) Then
- TxCAN (Port)
- Call WriteMsg("*** Canceled by USER ***", 1)
- TxyModem = False
- Exit Function
- End If
- 'issue message
- Message$ = "Packet " + Str$(Packet)
- Call WriteMsg(Message$, 1)
- 'load up internal buffer
- If Packet = 0 Then
- 'packet = 0. Init Buffer$ to 128 zeros.
- BlockSize = 128
- Buffer$ = String$(128, 0)
- If EmptyFlag Then
- 'send empty buffer
- Else
- 'not empty: copy filename to buffer
- K = 1
- L = Len(Filename$)
- Mid$(Buffer$, K, L) = Filename$
- K = K + L + 1
- 'copy file length to buffer
- Temp$ = Str$(FileBytes&)
- L = Len(Temp$)
- Mid$(Buffer$, K, L) = Temp$
- K = K + L + 1
- End If
- Else
- 'DATA Packet: use 1K or 128-byte blocks ?
- If BatchFlag And (Packet <= Number1K&) Then
- BlockSize = 1024
- Else
- BlockSize = 128
- End If
- 'compute # bytes to read
- If RemainingBytes& < BlockSize Then
- ReadSize = RemainingBytes&
- Else
- ReadSize = BlockSize
- End If
- 'read next block from disk
- Buffer$ = String$(ReadSize, 0)
- Get FileNbr, , Buffer$
- RemainingBytes& = RemainingBytes& - ReadSize
- 'pad short buffer with ^Z
- If ReadSize < BlockSize Then
- Buffer$ = Buffer$ + String$(BlockSize - ReadSize, &H1A)
- End If
- End If
- 'Send this packet
- If Not TxPacket(Port, Packet, Buffer$, BlockSize, NCGbyte) Then
- TxyModem = False
- Exit Function
- End If
- Code = SioDelay(5)
- 'must 'restart' after non null packet 0
- If (Not EmptyFlag) And (Packet = 0) Then
- Flag = TxStartup(Port, NCGbyte)
- End If
- Next Packet
- 'done if empty packet 0
- If EmptyFlag Then
- Call WriteMsg("Batch transfer completed", 1)
- TxyModem = True
- Exit Function
- End If
- 'all done. send EOT up to 10 times
- If Not TxEOT(Port) Then
- Print "EOT not acknowledged"
- TxyModem = False
- Exit Function
- End If
- Close FileNbr
- Call WriteMsg("Transfer completed", 1)
- TxyModem = True
- Exit Function
- TxyTrap:
- Select Case Err
- Case 52
- Message$ = "Cannot open " + Filename$ + " for read"
- Call WriteMsg(Message$, 1)
- Case Else
- Print "TX Error: "; Error$; " ("; Err; ")"
- End Select
- TxyModem = False
- Exit Function
- End Function
-
- Function XmodemRx (ByVal Port, Filename$, ByVal NCGbyte)
- If FetchName(Filename$) Then
- XmodemRx = RxyModem(Port, Filename$, NCGbyte, False)
- Else
- XmodemRx = False
- End If
- End Function
-
- Function XmodemTx (ByVal Port, Filename$, ByVal OneKflag)
- If FetchName(Filename$) Then
- XmodemTx = TxyModem(Port, Filename$, OneKflag, False)
- Else
- XmodemTx = False
- End If
- End Function
-
- Function YmodemRx (ByVal Port, Filename$, ByVal NCGbyte)
- YmodemRx = True
- Do
- AnyKey$ = INKEY$
- If AnyKey$ <> "" Then
- Call WriteMsg("Aborted by user", 1)
- Exit Do
- End If
- Call WriteMsg("Ready for next file", 1)
- Filename$ = ""
- If Not RxyModem(Port, Filename$, NCGbyte, True) Then
- YmodemRx = False
- Exit Function
- End If
- 'empty filename ?
- If Filename$ = "" Then
- Exit Function
- End If
- Loop
- End Function
-
- Function YmodemTx (ByVal Port, Filename$, ByVal OneKflag)
- If FetchName(Filename$) Then
- YmodemTx = TxyModem(Port, Filename$, OneKflag, True)
- 'send empty filename to terminate
- Filename$ = ""
- YmodemTx = TxyModem(Port, Filename$, OneKflag, True)
- Else
- YmodemTx = False
- End If
- End Function
-
-